home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 015 / page2.arc / STRPROCS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-06-04  |  6.6 KB  |  198 lines
  1. Unit StrProcs;
  2.  
  3. (*---------------------------------------------------------------------------*)
  4. (*                                                                           *)
  5. (*    This unit contains several utility routines dealing with strings.      *)
  6. (*    The routines are used by both the Page2 and Page2Cfg programs.         *)
  7. (*                                                                           *)
  8. (*                   by: R. P. Byrne      May 24, 1988                       *)
  9. (*                                                                           *)
  10. (*                                                                           *)
  11. (*   I have placed this unit and it's source code into the public domain     *)
  12. (*   in the hope that it may prove useful to someone other than myself.      *)
  13. (*                                                                           *)
  14. (*                                                        rpb                *)
  15. (*                                                       6/4/88              *)
  16. (*                                                                           *)
  17. (*                                                                           *)
  18. (*---------------------------------------------------------------------------*)
  19.  
  20.  
  21. { --------------------------------------------------------------------------- }
  22.    Interface
  23.       Uses Dos;
  24. { --------------------------------------------------------------------------- }
  25.  
  26. Function ToUpper(S : String) : String;
  27. { Convert a string to all upper case                                          }
  28.  
  29. Function Copies (C : Char; N : Integer ): String;
  30. { Create a string containing N copies of the character C                      }
  31.  
  32. Function  GetToken(Var Source : String; Caps : Boolean) : String;
  33. { Extract the next token from a string (destructively)                        }
  34.  
  35. Function NameOnly(FileName : String) : String;
  36. { Strip any drive/path information from a file specification                  }
  37.  
  38. Function IntStr(Int : Integer; Form : Integer) : String;
  39. { Convert a word or integer to a string [of length Form]                      }
  40.  
  41. Function DateStr : String;
  42. { Return the current date in string form:  Monthname dd, yyyy                 }
  43.  
  44. Function Strip(InputStr : String) : String;
  45. { Remove leading and trailing white space from a string                       }
  46.  
  47. { --------------------------------------------------------------------------- }
  48.   Implementation
  49. { --------------------------------------------------------------------------- }
  50.  
  51. Function ToUpper(S : String) : String;
  52. Var
  53.    I : Word;
  54. Begin
  55.    If Length(S) > 0 then
  56.       For I := 1 to Length(S) do
  57.          S[I] := UpCase(S[I]);
  58.    ToUpper := S;
  59. End {ToUpper};
  60.  
  61. { --------------------------------------------------------------------------- }
  62.  
  63. Function Copies (C : Char; N : Integer ): String;
  64. Var
  65.    Dest : String;
  66.    I    : Integer;
  67. Begin
  68.    Dest := '';
  69.    If N > 0 then
  70.       For I := 1 to N do
  71.          Dest := Dest + C;
  72.    Copies := Dest;
  73. End {Copies};
  74.  
  75. { --------------------------------------------------------------------------- }
  76.  
  77. Function IsWhite(Ch : Char) : Boolean;
  78. { This function is internal to the unit and is used by the GetToken and       }
  79. { Strip routines.                                                             }
  80. Begin
  81.                      { Space, Tab,  LF,  CR }
  82.    IsWhite := (Ch in [  #32,  #09, #10, #13 ]);
  83. End {IsWhite};
  84.  
  85. { --------------------------------------------------------------------------- }
  86.  
  87. Function IsDelim(Ch : Char) : Boolean;
  88. { This function is internal to the unit and is used by the GetToken routine   }
  89. Begin
  90.                       { Space, Tab,  LF,  CR, Hyphen, Slash }
  91.    IsDelim := ( Ch in [  #32,  #09, #10, #13,  #45,    #47  ] );
  92. End {IsDelim};
  93.  
  94. { --------------------------------------------------------------------------- }
  95.  
  96. Function  GetToken(Var Source : String; Caps : Boolean) : String;
  97. { Extract next token from a string (destructively) }
  98. Var
  99.    Token : String;
  100.    I     : Integer;
  101. Begin
  102.    I := 1;
  103.    Token := '';
  104.    If Length(Source) > 0 then begin
  105.       While (IsWhite(Source[I])) and (I <= Length(Source)) do
  106.          I := Succ(I);
  107.       If (I <= Length(Source)) then
  108.          Repeat
  109.             Token := Token + Source[I];
  110.             I := Succ(I);
  111.          Until (IsDelim(Source[I])) or (I > Length(Source));
  112.       If I >= Length(Source) then
  113.          Source := ''
  114.       else
  115.          Delete(Source, 1, I-1);
  116.    end {if};
  117.    If Caps then
  118.       Token := ToUpper(Token);
  119.    GetToken := Token;
  120. End {GetToken};
  121.  
  122. { --------------------------------------------------------------------------- }
  123.  
  124. Function NameOnly(FileName : String) : String;
  125. { Strip any drive/path information from a file specification }
  126. Var
  127.    I : Integer;
  128. Begin
  129.    I := 1;
  130.    While I <= Length(FileName) do
  131.       If (FileName[I] in [':', '\', '/']) then begin
  132.          Delete(FileName, 1, I);
  133.          I := 1
  134.       end {then}
  135.       else
  136.          I := Succ(I);
  137.    NameOnly := FileName;
  138. End {NameOnly};
  139.  
  140. { --------------------------------------------------------------------------- }
  141.  
  142. Function IntStr(Int : Integer; Form : Integer) : String;
  143. Var
  144.    S : String;
  145. Begin
  146.    If Form = 0 then
  147.       Str(Int, S)
  148.    else
  149.       Str(Int:Form, S);
  150.    IntStr := S;
  151. End {IntStr};
  152.  
  153. { --------------------------------------------------------------------------- }
  154.  
  155. Function DateStr : String;
  156. { Return the current date in string form:  Monthname dd, yyyy }
  157. Type
  158.    Str9 = String[9];
  159. Const
  160.    MonthName : Array[1..12] of Str9 = ('January', 'February', 'March',
  161.                                        'April', 'May', 'June', 'July',
  162.                                        'August', 'September', 'October',
  163.                                        'November', 'December');
  164. Var
  165.    Regs   : Registers;
  166. Begin
  167.    With Regs do begin
  168.       AH := $2A;
  169.       MsDos(Regs);
  170.       DateStr := MonthName[DH] + ' '  +
  171.                  IntStr(DL, 0) + ', ' +
  172.                  IntStr(CX, 0);
  173.    end {with};
  174. End {DateStr};
  175.  
  176. { -------------------------------------------------------------------------- }
  177.  
  178. Function Strip(InputStr : String) : String;
  179. Var
  180.    I, J : Integer;
  181. Begin
  182.    I := 1;
  183.    While IsWhite(InputStr[I]) and (I < Length(InputStr)) do
  184.       Inc(I);
  185.    J := Length(InputStr);
  186.    While IsWhite(InputStr[J]) and (J > 1) do
  187.       Dec(J);
  188.    If I <= J then
  189.       Strip := Copy(InputStr, I, J - Pred(I))
  190.    else
  191.       Strip := '';
  192. End {Strip};
  193.  
  194. { --------------------------------------------------------------------------- }
  195.  
  196. End {Unit StrProcs}.
  197.  
  198.